The World of Computer Software/The World of Computer Software.iso/drcpas10.zip/KEYBOARD.PAS

Pascal/Delphi Source File | 1992-11-17 | 6KB | 255 lines

{$A+,B-,D-,F-,I+,L-,N-,O-,R-,S+,V-}
unit keyboard;

(* by David R. Conrad, for Turbo Pascal 5.5

   This code is not copyrighted, you may use it freely.
   There are no guarantees, either expressed or implied,
   as to either merchantability or fitness for a particular
   purpose.  The author's liability is limited to the amount
   you paid for it.

   David R. Conrad, 17 Nov 92
   [e-mail]
   [e-mail]
*)

interface

const
  (* for testing shift key status *)
  RIGHTSHIFT = $01;
  LEFTSHIFT  = $02;
  CTRLKEY    = $04;
  ALTKEY     = $08;
  SCROLLLOCK = $10;
  NUMLOCK    = $20;
  CAPSLOCK   = $40;
  INSTOGGLE  = $80;
  (* these constants are only for enhanced keyboards *)
  LEFTCTRL   = $0100;
  LEFTALT    = $0200;
  RIGHTCTRL  = $0400;
  RIGHTALT   = $0800;
  SCROLLDOWN = $1000;
  NUMDOWN    = $2000;
  CAPSDOWN   = $4000;
  SYSRQDOWN  = $8000;
  (* for setting the delay rate *)
  delay250   = 0;
  delay500   = 1;
  delay750   = 2;
  delay1000  = 3;
  (* for setting the repeat rate *)
  fastkey    = $00;
  defaultkey = $0C;
  slowkey    = $1F;

var
  scancode, asciival : char;
{$IFDEF SCREENSAVE}
  lastkeypress, timeout : longint;
  screensaver : procedure;
{$ENDIF}

(* all routines are documented in the implementation section *)

function readkey : char;
function keypressed : boolean;
function shiftkeys : word;
function enhanced : boolean;
procedure typematic (kbddelay, repeatrate : byte);
function pushkey (ch : char) : boolean;
procedure clearkeys;
procedure waitkey;

implementation

uses dos, dostools
{$IFDEF SCREENSAVE}
                  , timer
{$ENDIF}
                         ;

const
  kbdint = $16;

var
  second : char;
  readfunc, pressfunc, shiftfunc : byte;

function readkey : char;
(* get key press, wait for one if necessary *)
(* returns #0 then scan code for extended keys, just like CRT.readkey *)
(* note: also puts ascii value and scan code in asciival and scancode *)
(* note: if SCREENSAVE is defined, calls keypressed repeatedly to allow
   screen saver to get control; see keypressed *)
var
  r : registers;
begin
  if second <> #0 then
    begin
      readkey := second;
      second := #0;
    end
  else
    begin
{$IFDEF SCREENSAVE}
      repeat until keypressed;
{$ENDIF}
      initregisters (r);
      r.ah := readfunc;
      intr (kbdint, r);
      if (r.al = $E0) and (r.ah <> 0) then r.al := 0;
      readkey := char(r.al);
      asciival := char(r.al);
      scancode := char(r.ah);
      if r.al = 0 then second := char(r.ah);
    end;
{$IFDEF SCREENSAVE}
  lastkeypress := ClockTix;
{$ENDIF}
end;

function keypressed : boolean;
(* tell whether any keystrokes are waiting; has a key been pressed? *)
(* note: if a key has been pressed, puts ascii value and scan code of
   key in asciival and scancode, allowing:
   if keypressed and (asciival = #27) then ....
   This does not remove the keystroke from the typeahead buffer.  *)
(* note: if SCREENSAVE is defined and more that timeout timer ticks
   have occured since the lastkeypress, the screen saver is invoked. *)
var
  r : registers;
  p : procedure;
begin
  if second <> #0 then
    keypressed := true
  else
    begin
{$IFDEF SCREENSAVE}
      if (@screensaver <> nil) and
         (difftix(lastkeypress, ClockTix) > timeout) then
        begin
          p := screensaver;
          @screensaver := nil;
          p;
          screensaver := p;
          lastkeypress := ClockTix;
        end;
{$ENDIF}
      initregisters (r);
      r.ah := pressfunc;
      intr (kbdint, r);
      if (r.al = $E0) and (r.ah <> 0) then r.al := 0;
      if (r.flags AND FZero) = FZero then
        keypressed := false
      else
        begin
          keypressed := true;
          asciival := char(r.al);
          scancode := char(r.ah);
        end;
    end;
end;

function shiftkeys : word;
(* get shift key state: upper byte only valid with enhanced keyboard *)
var
  r : registers;
begin
  initregisters (r);
  r.ah := shiftfunc;
  intr (kbdint, r);
  shiftkeys := r.ax;
end;

function enhanced : boolean;
(* tell whether an enhanced keyboard BIOS is present *)
var
  r : registers;
  a : byte;
begin
  initregisters (r);
  r.ah := $02;
  intr (kbdint, r);
  a := NOT r.al;
  r.ah := $12;
  r.al := a;
  intr (kbdint, r);
  enhanced := a <> r.al;
end;

procedure typematic (kbddelay, repeatrate : byte);
(* set the typematic delay and repeat rate on an enhanced keyboard *)
var
  r : registers;
begin
  initregisters (r);
  r.ah := $03;
  r.al := $05;
  if kbddelay > delay1000 then kbddelay := delay250;
  if repeatrate > slowkey then repeatrate := fastkey;
  r.bh := kbddelay;
  r.bl := repeatrate;
  intr (kbdint, r);
end;

function pushkey (ch : char) : boolean;
(* push a keystroke back into the typeahead buffer *)
(* note: the contents of the scancode variable are used for the scan code
   of the key; if the scan code matters, place it in that variable prior
   to calling this routine *)
(* note: will return false if the typeahead buffer is full or if no
   enhanced BIOS present *)
var
  r : registers;
begin
  initregisters (r);
  r.ah := $05;
  r.al := $01;
  r.cl := byte(ch);
  r.ch := byte(scancode);
  intr (kbdint, r);
  pushkey := r.al = 0;
end;

procedure clearkeys;
(* clear the typeahead buffer *)
begin
  while keypressed do if readkey = #0 then if readkey = #0 then;
end;

procedure waitkey;
(* wait for a keypress *)
begin
  if readkey = #0 then if readkey = #0 then;
end;

(* note: because of the auto-detection of the enhanced ROM BIOS and use
   of appropriate function numbers, these routine will work on original
   PC's and XT's and also allow full access to all features of enhanced
   keyboards, e.g. F11 & F12.
*)

begin
  second := #0;
  if enhanced then
    begin
      readfunc  := $10;
      pressfunc := $11;
      shiftfunc := $12;
    end
  else
    begin
      readfunc  := $00;
      pressfunc := $01;
      shiftfunc := $02;
    end;
{$IFDEF SCREENSAVE}
  @screensaver := nil;
  timeout := 5460;
  lastkeypress := ClockTix;
{$ENDIF}
end.